library("keras")
## Warning: package 'keras' was built under R version 4.0.3
library("dplyr")
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library("tensorflow")
library("grid")
library("gridExtra")
##
## Attaching package: 'gridExtra'
## The following object is masked from 'package:dplyr':
##
## combine
library("magick")
## Warning: package 'magick' was built under R version 4.0.4
## Linking to ImageMagick 6.9.11.57
## Enabled features: cairo, freetype, fftw, ghostscript, heic, lcms, pango, raw, rsvg, webp
## Disabled features: fontconfig, x11
library("viridis")
## Warning: package 'viridis' was built under R version 4.0.4
## Loading required package: viridisLite
tf$compat$v1$disable_eager_execution()
original_dataset_dir <- "Data/cats_and_dogs"
base_dir <- "Data/cats_and_dogs_small"
# dir.create(base_dir)
train_dir <- file.path(base_dir, "train")
# dir.create(train_dir)
validation_dir <- file.path(base_dir, "validation")
# dir.create(validation_dir)
test_dir <- file.path(base_dir, "test")
# dir.create(test_dir)
train_cats_dir <- file.path(train_dir, "cats")
# dir.create(train_cats_dir)
train_dogs_dir <- file.path(train_dir, "dogs")
# dir.create(train_dogs_dir)
validation_cats_dir <- file.path(validation_dir, "cats")
# dir.create(validation_cats_dir)
validation_dogs_dir <- file.path(validation_dir, "dogs")
# dir.create(validation_dogs_dir)
test_cats_dir <- file.path(test_dir, "cats")
# dir.create(test_cats_dir)
test_dogs_dir <- file.path(test_dir, "dogs")
model <- keras_model_sequential() %>%
layer_conv_2d(filters = 32, kernel_size = c(3, 3), activation = "relu",
input_shape = c(150, 150, 3)) %>%
layer_max_pooling_2d(pool_size = c(2, 2)) %>%
layer_conv_2d(filters = 64, kernel_size = c(3, 3), activation = "relu") %>%
layer_max_pooling_2d(pool_size = c(2, 2)) %>%
layer_conv_2d(filters = 128, kernel_size = c(3, 3), activation = "relu") %>%
layer_max_pooling_2d(pool_size = c(2, 2)) %>%
layer_conv_2d(filters = 128, kernel_size = c(3, 3), activation = "relu") %>%
layer_max_pooling_2d(pool_size = c(2, 2)) %>%
layer_flatten() %>%
layer_dropout(rate = 0.5) %>%
layer_dense(units = 512, activation = "relu") %>%
layer_dense(units = 1, activation = "sigmoid")
model %>% compile(
loss = "binary_crossentropy",
optimizer = optimizer_rmsprop(lr = 1e-4),
metrics = c("acc")
)
datagen <- image_data_generator(
rescale = 1/255,
rotation_range = 40,
width_shift_range = 0.2,
height_shift_range = 0.2,
shear_range = 0.2,
zoom_range = 0.2,
horizontal_flip = TRUE
)
test_datagen <- image_data_generator(rescale = 1/255)
train_generator <- flow_images_from_directory(
train_dir,
datagen,
target_size = c(150, 150),
batch_size = 20,
class_mode = "binary"
)
validation_generator <- flow_images_from_directory(
validation_dir,
test_datagen,
target_size = c(150, 150),
batch_size = 20,
class_mode = "binary"
)
history <- model %>% fit_generator(
train_generator,
steps_per_epoch = 100,
epochs = 100,
validation_data = validation_generator,
validation_steps = 50
)
model
## Model
## Model: "sequential"
## ________________________________________________________________________________
## Layer (type) Output Shape Param #
## ================================================================================
## conv2d (Conv2D) (None, 148, 148, 32) 896
## ________________________________________________________________________________
## max_pooling2d (MaxPooling2D) (None, 74, 74, 32) 0
## ________________________________________________________________________________
## conv2d_1 (Conv2D) (None, 72, 72, 64) 18496
## ________________________________________________________________________________
## max_pooling2d_1 (MaxPooling2D) (None, 36, 36, 64) 0
## ________________________________________________________________________________
## conv2d_2 (Conv2D) (None, 34, 34, 128) 73856
## ________________________________________________________________________________
## max_pooling2d_2 (MaxPooling2D) (None, 17, 17, 128) 0
## ________________________________________________________________________________
## conv2d_3 (Conv2D) (None, 15, 15, 128) 147584
## ________________________________________________________________________________
## max_pooling2d_3 (MaxPooling2D) (None, 7, 7, 128) 0
## ________________________________________________________________________________
## flatten (Flatten) (None, 6272) 0
## ________________________________________________________________________________
## dropout (Dropout) (None, 6272) 0
## ________________________________________________________________________________
## dense (Dense) (None, 512) 3211776
## ________________________________________________________________________________
## dense_1 (Dense) (None, 1) 513
## ================================================================================
## Total params: 3,453,121
## Trainable params: 3,453,121
## Non-trainable params: 0
## ________________________________________________________________________________
# model_bak <- model
# model %>% save_model_hdf5("cats_and_dogs_small_2.h5")
cat_img_path <- "Data/cats_and_dogs_small/test/cats/cat.1700.jpg"
cat_img <- image_load(cat_img_path, target_size = c(150, 150))
cat_img_tensor <- image_to_array(cat_img)
cat_img_tensor <- array_reshape(cat_img_tensor, c(1, 150, 150, 3))
cat_img_tensor <- cat_img_tensor / 255
dim(cat_img_tensor)
## [1] 1 150 150 3
plot(as.raster(cat_img_tensor[1,,,]))
dog_img_path <- "Data/cats_and_dogs_small/test/dogs/dog.1700.jpg"
dog_img <- image_load(dog_img_path, target_size = c(150, 150))
dog_img_tensor <- image_to_array(dog_img)
dog_img_tensor <- array_reshape(dog_img_tensor, c(1, 150, 150, 3))
dog_img_tensor <- dog_img_tensor / 255
dim(dog_img_tensor)
## [1] 1 150 150 3
plot(as.raster(dog_img_tensor[1,,,]))
layer_outputs <- lapply(model$layers[1:8], function(layer) layer$output)
activation_model <- keras_model(inputs = model$input, outputs = layer_outputs)
cat_activations <- activation_model %>% predict(cat_img_tensor)
dog_activations <- activation_model %>% predict(dog_img_tensor)
cat_first_layer_activation <- cat_activations[[1]]
dog_first_layer_activation <- dog_activations[[1]]
plot_channel <- function(channel) {
rotate <- function(x) t(apply(x, 2, rev))
image(rotate(channel), axes = FALSE, asp = 1,
col = terrain.colors(12))
}
plot_channel(cat_first_layer_activation[1,,,2])
plot_channel(dog_first_layer_activation[1,,,2])
image_size <- 58
images_per_row <- 16
for (i in 1:8) {
layer_activation <- cat_activations[[i]]
layer_name <- model$layers[[i]]$name
n_features <- dim(layer_activation)[[4]]
n_cols <- n_features %/% images_per_row
png(paste0("cat_activations_", i, "_", layer_name, ".png"),
width = image_size * images_per_row,
height = image_size * n_cols)
op <- par(mfrow = c(n_cols, images_per_row), mai = rep_len(0.02, 4))
for (col in 0:(n_cols-1)) {
for (row in 0:(images_per_row-1)) {
channel_image <- layer_activation[1,,,(col*images_per_row) + row + 1]
plot_channel(channel_image)
}
}
par(op)
dev.off()
}
image_size <- 58
images_per_row <- 16
for (i in 1:8) {
layer_activation <- dog_activations[[i]]
layer_name <- model$layers[[i]]$name
n_features <- dim(layer_activation)[[4]]
n_cols <- n_features %/% images_per_row
png(paste0("dog_activations_", i, "_", layer_name, ".png"),
width = image_size * images_per_row,
height = image_size * n_cols)
op <- par(mfrow = c(n_cols, images_per_row), mai = rep_len(0.02, 4))
for (col in 0:(n_cols-1)) {
for (row in 0:(images_per_row-1)) {
channel_image <- layer_activation[1,,,(col*images_per_row) + row + 1]
plot_channel(channel_image)
}
}
par(op)
dev.off()
}
By the last layer they look pretty similar and would be hard to tell apart
deprocess_image <- function(x) {
dms <- dim(x)
x <- x - mean(x)
x <- x / (sd(x) + 1e-5)
x <- x * 0.1
x <- x + 0.5
x <- pmax(0, pmin(x, 1))
array(x, dim = dms)
}
generate_pattern <- function(layer_name, filter_index, size = 150) {
layer_output <- model$get_layer(layer_name)$output
loss <- k_mean(layer_output[,,,filter_index])
grads <- k_gradients(loss, model$input)[[1]]
grads <- grads / (k_sqrt(k_mean(k_square(grads))) + 1e-5)
iterate <- k_function(list(model$input), list(loss, grads))
input_img_data <-
array(runif(size * size * 3), dim = c(1, size, size, 3)) * 20 + 128
step <- 1
for (i in 1:40) {
c(loss_value, grads_value) %<-% iterate(list(input_img_data))
input_img_data <- input_img_data + (grads_value * step)
}
img <- input_img_data[1,,,]
deprocess_image(img)
}
dir.create("cat_and_dog_vgg_filters")
## Warning in dir.create("cat_and_dog_vgg_filters"): 'cat_and_dog_vgg_filters'
## already exists
layer_list <- c()
for(i in 1:8){
layer_list <- c(layer_list, get_layer(model, index = i)$name)
}
for (layer_name in layer_list) {
size <- 140
png(paste0("cat_and_dog_vgg_filters/", layer_name, ".png"),
width = 8 * size, height = 8 * size)
grobs <- list()
for (i in 0:7) {
for (j in 0:3) {
pattern <- generate_pattern(layer_name, i + (j*8) + 1, size = size)
grob <- rasterGrob(pattern,
width = unit(0.9, "npc"),
height = unit(0.9, "npc"))
grobs[[length(grobs)+1]] <- grob
}
}
grid.arrange(grobs = grobs, ncol = 8)
dev.off()
}
1
2
7